VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDirSendFormC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Public CrystalConnectString As String
Dim cJMail As clsJMail
Public nNewCaseNumber
Public Sub SendFormC()
    
On Error GoTo Send_FormC_Error
    Dim sStage As String
        sStage = ""
    
    Dim adoConn As ADODB.Connection
    Dim adoComm As ADODB.Command
    Dim adors As ADODB.Recordset
    Dim adoRsParam As ADODB.Recordset
    Dim adorsSupportMsg As ADODB.Recordset
    Dim adorsEMail As ADODB.Recordset
    
    Dim nRequestNumber As Long
    Dim sEmailWStnEmail As String
    Dim sPDFPath As String
    Dim sSupportMsg As String
    Dim iCounter As Integer
    Dim bIsTaxDeclined As Boolean
    Dim sFileName As String
    Dim sEMailBody As String
    Dim nRemCount As Long, nComplCount As Long
    
    Dim blReportGenerated As Boolean
    Dim blMKIntegrationDone As Boolean
    
    
    'Check to see if this applications isn't already running. If so, exit function
    Call IsAppRunning
    If IsAppRunning = True Then
        Exit Sub
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Instantiate recordsets and command sets

    Set adoComm = New ADODB.Command
    Set adors = New ADODB.Recordset
    Set adoRsParam = New ADODB.Recordset
    Set adorsSupportMsg = New ADODB.Recordset
    Set adorsEMail = New ADODB.Recordset
'*********************************************************************************************************************
    
    
'*********************************************************************************************************************
'create connection to SQL Server
    
    Set adoConn = New ADODB.Connection
    With adoConn
        .CursorLocation = adUseClient
        .IsolationLevel = adXactBrowse
        .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
        .Open
    End With
'*********************************************************************************************************************


'*********************************************************************************************************************
'Get directive details

    With adoComm
        .CommandText = "dir_directives_hardcopy_vw"
        .CommandType = adCmdTable
        Set .ActiveConnection = adoConn
    End With
    
    adors.Open "dir_directives_hardcopy_vw", adoConn 'retrieve data
    
    If adors Is Nothing Then
        ShowError 0, "No records found to email.", "No records"
        Exit Sub
    Else
        If adors.EOF Then
            ShowError 0, "No records found to email.", "No records"
            Exit Sub
        End If
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
' Get Parameter values

    sStage = "Getting Parameters"
    ShowStage sStage
    
    sEmailWStnEmail = GetParameterValue(sStage, "EMAIL_WSTN_ADDR", adoConn) 'Get the email workstation's address from the params table
    sPDFPath = GetParameterValue(sStage, "EMAIL_HOME", adoConn) 'Get directory to save PDFs to
    sPDFPath = "C:\" 'override value, for testing purposes
    
    If Trim(sEmailWStnEmail) = "" Then
        SendErrorEmail 0, "EMAIL_WSTN_ADDR parameter is not set up. Cannot process emails"
        Exit Sub
    End If
    
    If Trim(sPDFPath) = "" Then
        SendErrorEmail 0, "EMAIL_HOME parameter is not set up. Cannot process emails"
        Exit Sub
    End If
    
    'Delete any existing PDF files in the path
    If Dir(sPDFPath & "*.pdf") <> "" Then Kill sPDFPath & "*.pdf"
    
'*********************************************************************************************************************


'*********************************************************************************************************************
' Support Clause to add to end of email
    
    sStage = "Getting Email Footer"
    ShowStage sStage
    
    adorsSupportMsg.Open "dir_get_email_footnote", adoConn 'retrieve data
    
    'no support message then ignore
    If Not adorsSupportMsg.EOF Then
      sSupportMsg = adorsSupportMsg(0)
    End If
    
    adorsSupportMsg.Close
    
    Set adorsSupportMsg = Nothing
'*********************************************************************************************************************
    
    
'*********************************************************************************************************************
' Step through each retrieved response and process and build the email body and attachment

    nRemCount = 0
    nComplCount = 0
    iCounter = 0
    
    If Not adors.EOF Then nRemCount = adors.RecordCount
    
    Form2.Show
    
    
    While Not adors.EOF
        If Form2.chkStopAfterNext.Value = 1 Then Exit Sub 'if the checkbox to stop after next request is checked, exit
        
        bIsTaxDeclined = False 'reset indicator
        
        UpdateRemainingCount nRemCount, nComplCount 'Update status label
        
        nRequestNumber = adors.Fields("req_seq_num").Value
        
        'Get the email body for the request
        If adors.Fields("scod_form_type") = "IRP3A" Then
            adorsEMail.Open "dir_get_email_body_irp3a " & nRequestNumber, adoConn
        Else
            adorsEMail.Open "dir_get_email_body " & nRequestNumber, adoConn
        End If
        
        
        'Set up the Crystal Reports page
        blReportGenerated = SetUpReport(sStage, sFileName, iCounter, sPDFPath, adors, adorsEMail, adoComm, adoConn)
        If Not blReportGenerated Then
            SendErrorEmail nRequestNumber, "Could not create directive PDF, cannot continue"
            Exit Sub
        End If
        
        
        
        'Generate email body text
        sEMailBody = BuildEmailBody(sStage, sSupportMsg, adors, adorsEMail, adoConn)
        
        
        
        'SECTION: Workflow Integration
        sStage = "Performing Mindkey Integration"
        If IsInterfaceRequest(nRequestNumber, adoConn) Or IsForcedInterface(nRequestNumber, adors, adoConn) Then
            'Do not interface cancelled requests
            If Not IsCancelledRequest(nRequestNumber, adoConn) Then
                nNewCaseNumber = "" 'reset value
                
                blMKIntegrationDone = DoMindkeyIntegration(sStage, nRequestNumber, _
                                                           adors, adorsEMail, _
                                                           sEMailBody, sFileName, _
                                                           adoConn)
                
                sStage = "Mindkey Integration done: " & blMKIntegrationDone & ". Case Number: " & nNewCaseNumber
                ShowStage sStage
                
                If blMKIntegrationDone = False Then
                    ShowError 1, "Could not complete Mindkey Integration", sStage
                    'Exit Sub
                End If
            Else
                ShowError 1, nRequestNumber & " is a cancelled request. Mindkey Interface not done", sStage
            End If
        Else
            SendEmail sStage, nRequestNumber, _
                      adorsEMail.Fields("TAXPAYER") & ": Directive requested on " & Format(adorsEMail.Fields("REQUEST_DATE"), "YYYYMMDD"), _
                      sEMailBody, sFileName, _
                      adors.Fields("EMAIL_ADDRESS"), adorsEMail.Fields("REQUESTED_BY")
        End If
        
        
        'SECTION: Mark as emailed
        adoConn.Execute "dir_update_emailed_yn " & nRequestNumber & ", 'Y'"
        
        sStage = "Emailed set to Y"
        ShowStage sStage
        
        'Increase counters
        nRemCount = nRemCount - 1
        nComplCount = nComplCount + 1
        
        adorsEMail.Close 'close the directive detail recordset
        adors.MoveNext 'move to next Directive to process
        
        'if we've done 120, jump out, or the Crystal Reports Export will crash. The program will start automatically
        'from the scheduler again in five minutes. It's a nasty hack, yes, but there's no other way to get this prog
        'to run unattended
        If nComplCount = 120 Then Exit Sub
    
    Wend 'no more directives to process
    
    
    
    Set cJMail = Nothing
    
    'Clean Up
    crFormC.DiscardSavedData 'clear out report data
    adorsEMail.Close
    Set adorsEMail = Nothing
    adors.Close
    Set adors = Nothing
    adoConn.Close
    Set adoConn = Nothing
    Set objReg = Nothing
    
    'Clean up PDF files
    If Dir(sPDFPath & "*.pdf") <> "" Then Kill sPDFPath & "*.pdf"
    
    'Clean up TXT files
    If Dir(sPDFPath & "*.txt") <> "" Then Kill sPDFPath & "*.txt"
    
    Unload Form2
    
    Exit Sub
    
Send_FormC_Error:
    
    If Err <> 13 And Err <> 94 Then
      sStage = sStage & " " & Err.Description
      ShowStage sStage
      
'      While InStr(sStage, "'") > 0
'        sStage = Left(sStage, InStr(sStage, "'") - 1) & "`" & Mid$(sStage, InStr(sStage, "'") + 1)
'      Wend
'      ShowStage sStage
      
      ShowError Err.Number, Err.Description, sStage
    End If
    
    'Resume Next

End Sub

Private Function SetUpReport(ByRef sStage As String, ByRef sFileName As String, ByRef iCounter As Integer, ByRef sPDFPath As String, _
                             ByRef adors As ADODB.Recordset, ByRef adorsEMail As ADODB.Recordset, _
                             ByRef adoComm As ADODB.Command, ByRef adoConn As ADODB.Connection) As Boolean
On Error GoTo PROC_EXIT

    sStage = "Getting EMail Body"
    ShowStage sStage
    
    Dim sConnStr As String
    Dim sIT88_Ref As String, adorsIT88 As ADODB.Recordset
    Dim dTotalTax  As Long
    Dim oRegistry As clsRegistry
    Set oRegistry = New clsRegistry
    
    'Johann(20090715): If the system is set up to skip the generation of PDF files (for testin purposes), jump out
    If oRegistry.SkipReportGeneration = "Y" Then
        SetUpReport = True
        GoTo PROC_EXIT
    End If
    
    sFileName = ""
    
    If Not adorsEMail.EOF Then
      
      iCounter = iCounter + 1
      UpdateList iCounter, adors.Fields("req_seq_num") & " requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD") & " for " & adorsEMail.Fields("Taxpayer")
      'adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
    
      sStage = "Checking EMail Body"
      ShowStage sStage
    
      If adorsEMail.Fields("create_pdf_yn") = "Y" Then 'process successful Request
        
        crFormC.RecordSelectionFormula = " {DIR_directives_hardcopy_vw.req_seq_num} = " & adors.Fields("req_seq_num").Value
        
        sStage = "Clearing Old Body " & adors.Fields("req_seq_num")
        ShowStage sStage
    
        sConnStr = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
        
        If PopulateReport(sConnStr, adoComm) <> True Then
            Exit Function
        End If
        
        sStage = "Getting Report Body " & adors.Fields("req_seq_num")
        ShowStage sStage
        
        crFormC.ReadRecords 'get data
        
        'Sort Fund Address and move Postal Code to last free address line
        If IsNull(adors.Fields("addr_l2")) = True Then
          crFormC.FormulaFields(19).Text = Chr(34) & adors.Fields("addr_l2") & Chr(34)
        Else
            crFormC.FormulaFields(19).Text = Chr(34) & Replace(Replace(adors.Fields("addr_l2"), "'", "''"), "", """") & Chr(34)
        End If
        
        If IsNull(adors.Fields("addr_l3")) = True Then
          crFormC.FormulaFields(20).Text = Chr(34) & adors.Fields("addr_l3") & Chr(34)
        Else
          crFormC.FormulaFields(20).Text = Chr(34) & Replace(Replace(adors.Fields("addr_l3"), "'", "''"), "", """") & Chr(34)
        End If
        
        If IsNull(adors.Fields("addr_l4")) = True Then
          crFormC.FormulaFields(21).Text = Chr(34) & adors.Fields("addr_l4") & Chr(34)
        Else
          crFormC.FormulaFields(21).Text = Chr(34) & Replace(Replace(adors.Fields("addr_l4"), "'", "''"), """", """""") & Chr(34)
        End If
        
        crFormC.FormulaFields(22).Text = Chr(34) & adors.Fields("Postal_Code") & Chr(34)
        
        If crFormC.FormulaFields(21).Text = Chr(34) & Chr(34) Then
          crFormC.FormulaFields(21).Text = crFormC.FormulaFields(22).Text
          crFormC.FormulaFields(22).Text = ""
          If crFormC.FormulaFields(20).Text = Chr(34) & Chr(34) Then
            crFormC.FormulaFields(20).Text = crFormC.FormulaFields(21).Text
            crFormC.FormulaFields(21).Text = ""
            If crFormC.FormulaFields(19).Text = Chr(34) & Chr(34) Then
              crFormC.FormulaFields(19).Text = crFormC.FormulaFields(20).Text
              crFormC.FormulaFields(20).Text = ""
            End If
          End If
        End If
        
        'Sort address and move Postal Code to last free address line
        crFormC.FormulaFields(15).Text = Chr(34) & Replace(Replace(adors.Fields("home_addr_l2"), "'", "''"), """", """""") & Chr(34)
        If IsNull(adors.Fields("home_addr_l3")) = True Then
          crFormC.FormulaFields(16).Text = Chr(34) & adors.Fields("home_addr_l3") & Chr(34)
        Else
          crFormC.FormulaFields(16).Text = Chr(34) & Replace(Replace(adors.Fields("home_addr_l3"), "'", "''"), """", """""") & Chr(34)
        End If
        
        If IsNull(adors.Fields("home_addr_l4")) = True Then
          crFormC.FormulaFields(17).Text = Chr(34) & adors.Fields("home_addr_l4") & Chr(34)
        Else
          crFormC.FormulaFields(17).Text = Chr(34) & Replace(Replace(adors.Fields("home_addr_l4"), "'", "''"), """", """""") & Chr(34)
        End If
        
        crFormC.FormulaFields(18).Text = Chr(34) & adors.Fields("home_Postal_Code") & Chr(34)
        
        If crFormC.FormulaFields(17).Text = Chr(34) & Chr(34) Then
          crFormC.FormulaFields(17).Text = crFormC.FormulaFields(18).Text
          crFormC.FormulaFields(18).Text = ""
          If crFormC.FormulaFields(16).Text = Chr(34) & Chr(34) Then
            crFormC.FormulaFields(16).Text = crFormC.FormulaFields(17).Text
            crFormC.FormulaFields(17).Text = ""
            If crFormC.FormulaFields(15).Text = Chr(34) & Chr(34) Then
              crFormC.FormulaFields(15).Text = crFormC.FormulaFields(16).Text
              crFormC.FormulaFields(16).Text = ""
            End If
          End If
        End If
        
        'Display only relevant text based on form type
        If adors.Fields("scod_form_type") = "FORM_AD" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adors.Fields("scod_form_type") = "FORM_B" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adors.Fields("scod_form_type") = "FORM_C" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adors.Fields("scod_form_type") = "IRP3A" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adors.Fields("scod_form_type") = "IRP3B" Then
          crFormC.Section8.Suppress = True
          crFormC.Section9.Suppress = False
          crFormC.Section10.Suppress = True
        ElseIf adors.Fields("scod_form_type") = "IRP3C" Then
          crFormC.Section8.Suppress = True
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = False
        End If
        
        'Display either fund details or employer details
        If adors.Fields("scod_form_type") = "FORM_AD" Or adors.Fields("scod_form_type") = "FORM_B" Or adors.Fields("scod_form_type") = "FORM_C" Then
          crFormC.Section5.Suppress = True
          crFormC.Section6.Suppress = False
          crFormC.Section11.Suppress = False
        ElseIf adors.Fields("scod_form_type") = "IRP3A" Or adors.Fields("scod_form_type") = "IRP3B" Or adors.Fields("scod_form_type") = "IRP3C" Then
          crFormC.Section5.Suppress = False
          crFormC.Section6.Suppress = True
          crFormC.Section11.Suppress = True
        End If
        
        crFormC.ExportOptions.DiskFileName = sPDFPath & adors.Fields("Directive_number") & ".PDF"
        crFormC.ExportOptions.FormatType = crEFTPortableDocFormat '(PDF)
        crFormC.ExportOptions.DestinationType = crEDTDiskFile
        sStage = "Checking for IT88 " & adors.Fields("req_seq_num")
        ShowStage sStage
        
        If Not IsNull(adors.Fields("it88_ref_no")) Then sIT88_Ref = adors.Fields("it88_ref_no")
        If Not IsNull(sIT88_Ref) Then sIT88_Ref = Trim(sIT88_Ref)
        
        If sIT88_Ref = "" Then 'no IT88 Form required
          sStage = "Hiding IT88 notification on directive page"
          ShowStage sStage
          
          crFormC.FormulaFields.Item(2).Text = ""
          sStage = "Hiding IT88 Page"
          ShowStage sStage
          
          crFormC.Section13.Suppress = True
        Else
          sStage = "Showing IT88 Page"
          ShowStage sStage
          
          crFormC.Section13.Suppress = False 'add IT88 onto Form C
          
          sStage = "Getting IT88 Details " & adors.Fields("req_seq_num")
          ShowStage sStage
          
          Set adorsIT88 = New ADODB.Recordset
          
          adorsIT88.Open "Dir_get_it88_detail " & adors.Fields("req_seq_num"), adoConn 'retrieve data
          
          If adorsIT88.EOF Then 'if IT88 details cannot be retrieved then report error
            SendErrorEmail adors.Fields("req_seq_num"), "Unable to access IT88 details for REQ_SEQ_NUM-" & adors.Fields("req_seq_num")
            
            adorsIT88.Close
            
            Set adorsIT88 = Nothing
            Set adoConn = Nothing
            
            SetUpReport = False
            Exit Function
          End If
          
          sStage = "Inserting IT88 Details " & adors.Fields("req_seq_num")
          ShowStage sStage
          
          'Reset Tax Calculation table to default values
          crFormC.FormulaFields.Item(4).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(5).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(6).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(7).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(8).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(10).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(11).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(12).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(13).Text = Chr(34) & "0.00" & Chr(34)
          
          dTotalTax = 0
          
          'Move data from Recordset into Formulas on Report
          crFormC.FormulaFields.Item(2).Text = Chr(34) & adorsIT88.Fields("it88_ref_no").Value & Chr(34)
          crFormC.FormulaFields.Item(3).Text = Chr(34) & adorsIT88.Fields("stop_order_rsn").Value & Chr(34)
          
          If adorsIT88.Fields("vat_reg_no").Value <> "" Then crFormC.FormulaFields.Item(4).Text = Chr(34) & adorsIT88.Fields("vat_reg_no").Value & Chr(34)
          If adorsIT88.Fields("vat_amount").Value <> "" Then crFormC.FormulaFields.Item(5).Text = Chr(34) & Format(adorsIT88.Fields("vat_amount").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("vat_amount").Value), 0, adorsIT88.Fields("vat_amount").Value)
          
          If Not IsNull(adorsIT88.Fields("paye_amt").Value) Then crFormC.FormulaFields.Item(6).Text = Chr(34) & Format(adorsIT88.Fields("paye_amt").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("paye_amt").Value), 0, adorsIT88.Fields("paye_amt").Value)
          
          If Not IsNull(adorsIT88.Fields("per1").Value) Then crFormC.FormulaFields.Item(7).Text = Chr(34) & adorsIT88.Fields("per1").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("per2").Value) Then crFormC.FormulaFields.Item(8).Text = Chr(34) & adorsIT88.Fields("per2").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("per3").Value) Then crFormC.FormulaFields.Item(9).Text = Chr(34) & adorsIT88.Fields("per3").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("amt1").Value) Then crFormC.FormulaFields.Item(10).Text = Chr(34) & Format(adorsIT88.Fields("amt1").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt1").Value), 0, adorsIT88.Fields("amt1").Value)
          
          If Not IsNull(adorsIT88.Fields("amt2").Value) Then crFormC.FormulaFields.Item(11).Text = Chr(34) & Format(adorsIT88.Fields("amt2").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt2").Value), 0, adorsIT88.Fields("amt2").Value)
          
          If Not IsNull(adorsIT88.Fields("amt3").Value) Then crFormC.FormulaFields.Item(12).Text = Chr(34) & Format(adorsIT88.Fields("amt3").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt3").Value), 0, adorsIT88.Fields("amt3").Value)
          
          If Not IsNull(adorsIT88.Fields("assessed_tax_amt").Value) Then crFormC.FormulaFields.Item(13).Text = Chr(34) & Format(adorsIT88.Fields("assessed_tax_amt").Value, "#,##0.00") & Chr(34)
          
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("assessed_tax_amt").Value), 0, adorsIT88.Fields("assessed_tax_amt").Value)
          
          
          crFormC.FormulaFields.Item(14).Text = Chr(34) & Format(dTotalTax, "#,##0.00") & Chr(34)
          adorsIT88.Close
    
        End If
        
        sStage = "Exporting FormC Data " & adors.Fields("req_seq_num")
        ShowStage sStage
        
        MsgBox "Reimplement this on production!"
        'crFormC.ExportOptions.PDFExportAllPages = True
        'crFormC.ExportOptions.PDFLastPageNumber = 5
        crFormC.Export (False) 'data to disk
        
        sFileName = sPDFPath & adors.Fields("directive_number") & ".pdf" 'attach PDF file
        
      End If
    
      SetUpReport = True
    Else 'if EMail body missing
        SendErrorEmail adors.Fields("req_seq_num"), "No EMail Body Located for ID: " & adors.Fields("req_seq_num")
        SetUpReport = False
    End If

PROC_EXIT:
    Set oRegistry = Nothing
    
    Exit Function
    
End Function

Private Function BuildEmailBody(ByRef sStage As String, ByVal sSupportMsg As String, _
                                ByRef adors As ADODB.Recordset, ByRef adorsEMail As ADODB.Recordset, _
                                ByRef adoConn As ADODB.Connection) As String
    
    sStage = "Creating EMail Body"
    ShowStage sStage
    
    Dim sEMailBody As String
    Dim adorsDeclineRsn As ADODB.Recordset 'Added 20/08/2000 to retrieve Decline Reasons for decline
    Dim bFirstReason As Boolean 'Added 20/08/2000 to retrieve Decline Reasons for decline


    'Build EMail Body
    sEMailBody = "SARS Application No : " & vbTab & adorsEMail.Fields("SARS_appl_id") & vbCrLf
    sEMailBody = sEMailBody & "KeyTax request number : " & vbTab & adorsEMail.Fields("req_seq_num") & vbCrLf
    
    If adors.Fields("scod_form_type") <> "IRP3A" Then
        sEMailBody = sEMailBody & "Fund : " & vbTab & vbTab & vbTab & vbTab & adorsEMail.Fields("Fund") & vbCrLf
        sEMailBody = sEMailBody & "Contract number : " & vbTab & vbTab & adorsEMail.Fields("Contract_number") & vbCrLf
    End If
    
    sEMailBody = sEMailBody & "Tax Payer : " & vbTab & vbTab & vbTab & adorsEMail.Fields("Taxpayer") & vbCrLf
    sEMailBody = sEMailBody & "Directive number : " & vbTab & vbTab & adorsEMail.Fields("directive_number") & vbCrLf
    sEMailBody = sEMailBody & "Requested date : " & vbTab & vbTab & Format(adorsEMail.Fields("request_date"), "DD/MM/YYYY") & vbCrLf
    sEMailBody = sEMailBody & "Requested by : " & vbTab & vbTab & vbTab & adorsEMail.Fields("requested_by") & vbCrLf
    sEMailBody = sEMailBody & "Request status : " & vbTab & vbTab & adorsEMail.Fields("request_status") & vbCrLf & vbCrLf
    
    If (UCase(adorsEMail.Fields("request_status")) = "APPLICATION DECLINED") Or (UCase(adorsEMail.Fields("request_status")) = "DIRECTIVE DECLINED") Then
        
        sStage = "Getting Decline Reasons"
        ShowStage sStage
        
        bFirstReason = True
        
        Set adorsDeclineRsn = New ADODB.Recordset
        adorsDeclineRsn.Open "select * from dir_decline_reasons where req_seq_num =" & adorsEMail.Fields("req_seq_num"), adoConn 'retrieve data
        
        While Not adorsDeclineRsn.EOF
            If bFirstReason Then
                If adorsDeclineRsn.Fields("decline_reason_code") = "05807" Then
                    sEMailBody = sEMailBody & "Decline Reason(s) : " & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": Refer to your local Receiver of Revenue office." & vbCrLf
                Else
                    sEMailBody = sEMailBody & "Decline Reason(s) : " & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": " & adorsDeclineRsn.Fields("decline_reason_text") & vbCrLf
                End If
                
                bFirstReason = False
            Else
                If adorsDeclineRsn.Fields("decline_reason_code") = "05807" Then
                    sEMailBody = sEMailBody & vbTab & vbTab & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": Refer to your local Receiver of Revenue office." & vbCrLf
                Else
                    sEMailBody = sEMailBody & vbTab & vbTab & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": " & adorsDeclineRsn.Fields("decline_reason_text") & vbCrLf
                End If
            End If
            adorsDeclineRsn.MoveNext
        Wend
        
        adorsDeclineRsn.Close
        Set adorsDeclineRsn = Nothing
    End If
    
    sEMailBody = sEMailBody & vbCrLf & sSupportMsg
    
    BuildEmailBody = sEMailBody
End Function


'************************************************************************
'****       AUTHOR:     Johann Marx
'****       DATE:       2009/06/29
'****       FUNCTION:   KeyTax Mindkey Integration.
'****       COMMENTS:   This code will check if the current response
'****                   is for an automated request, if it is a second
'****                   email will be sent to an Email Workstation address
'****                   for autologger commital to the workflow.
'************************************************************************
Private Function DoMindkeyIntegration(ByRef sStage As String, ByVal nRequestNumber As Long, _
                                      ByRef adors As ADODB.Recordset, ByRef adorsEMail As ADODB.Recordset, _
                                      ByVal sEMailBody As String, ByVal sFileName As String, _
                                      adoConn As ADODB.Connection) As Boolean
On Error GoTo PROC_EXIT

    sStage = "Submitting Email 2"
    ShowStage sStage
    
    Dim sSQL As String
    Dim rsHolder As ADODB.Recordset
    
    Dim blReturnValue As Boolean
        blReturnValue = True 'startup value. We're going to return true, unless something goes wrong
        
    Dim blHasAutoRequestRecord As Boolean
    Dim sIncludeInEmailParam As String, arIncludeInEmailParam() As String
    Dim sSendEmailToClient As String
    Dim lListCount As Long
    
    Dim blWorkItemCreated As Boolean, sCreateWorkErrorMessage As String
    
    blHasAutoRequestRecord = False 'start up value
    
'*********************************************************************************************************************
'Check the EMAIL_SEND_YN parameter to see whether an email should be sent to the client for this request

    sSendEmailToClient = GetParameterValue(sStage, "EMAIL_SEND_YN", adoConn)
    
    If Trim(sSendEmailToClient) = "" Then
        SendErrorEmail 0, "EMAIL_SEND_YN parameter is not set up. Cannot process emails"
        blReturnValue = False
        GoTo PROC_EXIT
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Check if the current response has an auto request record. The request reason for the directive determines whether
'it should be sent to Mindkey or not.

    sIncludeInEmailParam = GetParameterValue(sStage, "INCLUDE_IN_EMAIL", adoConn)
    
    'If this parameter is not set up, break
    arIncludeInEmailParam = Split(sIncludeInEmailParam, ",")
    
    'Compare the parameter value with the request reason for this request
    If UBound(arIncludeInEmailParam) > 0 Then
        sSQL = "select scod_dir_req_rsn from dir_request where req_seq_num = " & nRequestNumber
        Set rsHolder = adoConn.Execute(sSQL)
        
        For lListCount = 0 To UBound(arIncludeInEmailParam) - 1
            If arIncludeInEmailParam(lListCount) = rsHolder.Fields("scod_dir_req_rsn") Then
                blHasAutoRequestRecord = True
                Exit For
            End If
        Next
    Else
        ShowError 0, "INCLUDE_IN_EMAIL parameter is not set up. Cannot continue", sStage
        blReturnValue = False
        GoTo PROC_EXIT
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Send email and/or commit documents
    
    'If mail to client is set to "Y" or it's not auto request response, send a mail to the client/user
    If sSendEmailToClient = "Y" Or Not blHasAutoRequestRecord Then
        SendEmail sStage, nRequestNumber, _
                  adorsEMail.Fields("TAXPAYER") & ": Directive requested on " & Format(adorsEMail.Fields("REQUEST_DATE"), "YYYYMMDD"), _
                  sEMailBody, sFileName, _
                  adors.Fields("EMAIL_ADDRESS"), adors.Fields("REQUESTED_BY")
                              
    End If
    
    'If the response has an auto request record, i.e. it's an interface request
    If blHasAutoRequestRecord Then
        'If the filename does not exist, create a file from the email body
        If Len(Trim(sFileName)) = 0 Then
            sFileName = CreateTextFileFromBody(sEMailBody, CStr(nRequestNumber))
        End If
        
        'If we have a file to commit, do so
        If Len(Trim(sFileName)) > 0 Then
            sStage = "Committing document and creating work item"
            ShowStage sStage
            
            blWorkItemCreated = SaveCommitDetail(CStr(nRequestNumber), sFileName, adoConn, sCreateWorkErrorMessage)
            
            sStage = "Committing document and creating work item done"
            ShowStage sStage
            
            'if the work item could not be created, send an email to the support email address
            If Not blWorkItemCreated And Len(sCreateWorkErrorMessage) > 0 Then
                SendErrorEmail nRequestNumber, _
                               "An error has occurred while trying to commit the document for request number " & nRequestNumber & " to Mindkey. Error: " & sCreateWorkErrorMessage
                
                ShowError 0, "SaveCommitDetail Error: " & sCreateWorkErrorMessage, sStage
                
                blReturnValue = False
            End If
            
        End If
    End If
'*********************************************************************************************************************

PROC_EXIT:
    Set rsHolder = Nothing
    
    If Err.Number <> 0 Then
        blReturnValue = False
        ShowError Err.Number, Err.Description, sStage
    End If
    
    DoMindkeyIntegration = blReturnValue
End Function

'************************************************************************
'****       AUTHOR:     Johann Marx
'****       DATE:       2009/06/29
'****       FUNCTION:   Interface Request Check
'****       COMMENTS:   This code will check if the current response
'****                   is an interface request
'************************************************************************
Private Function IsInterfaceRequest(ByVal nRequestNumber As Long, ByRef adoConn As ADODB.Connection) As Boolean
On Error GoTo PROC_EXIT

    Dim sSQL As String
    Dim blReturnValue As Boolean
    Dim rsInterfaceIndex As ADODB.Recordset
    
    'Check if it's an interface request
    sSQL = "select count(*) from DIR_INTERFACE_INDEX where REQ_SEQ_NUM = " & nRequestNumber
    
    Set rsInterfaceIndex = adoConn.Execute(sSQL)

    blReturnValue = rsInterfaceIndex.Fields(0).Value > 0
    
PROC_EXIT:
    Set rsInterfaceIndex = Nothing
    
    If Err.Number <> 0 Then blReturnValue = False
    
    IsInterfaceRequest = blReturnValue
    
End Function

'************************************************************************
'****       AUTHOR:     Johann Marx
'****       DATE:       2009/07/01
'****       FUNCTION:   Is forced interface request?
'****       COMMENTS:   This code will check if the current response
'****                   should be forced to interface with Mindkey.
'****                   It was created to force non-interface requests
'****                   for a requirement for the bulk TUB cancellations.
'************************************************************************
Private Function IsForcedInterface(ByVal nRequestNumber As Long, ByRef adors As ADODB.Recordset, ByRef adoConn As ADODB.Connection) As Boolean
On Error GoTo PROC_EXIT

    Dim sSQL As String
    Dim blReturnValue As Boolean
    Dim nFundNumber As String
    
    nFundNumber = adors.Fields("FUND_NUMBER").Value
    
    'Staff funds override. Always do integration if one of these fund numbers are used.
    If nFundNumber = "18204015367" Or nFundNumber = "18204041203" Or nFundNumber = "18204012995" Then
        blReturnValue = True
    Else
        blReturnValue = False
    End If
    
PROC_EXIT:
    If Err.Number <> 0 Then blReturnValue = False
    
    IsForcedInterface = blReturnValue
    
End Function

Private Function IsCancelledRequest(ByVal nRequestNumber As Long, ByRef adoConn As ADODB.Connection) As Boolean
On Error GoTo PROC_EXIT

    Dim sSQL As String
    Dim blReturnValue As Boolean
    Dim rsRequestDetails As ADODB.Recordset
    
    'Check if the request is cancelled
    sSQL = "select"
    sSQL = sSQL & " SCOD_DIR_REQ_RSN , REQUEST_STATUS, CANCEL_STATUS"
    sSQL = sSQL & " from DIR_REQUEST, DIR_RESPONSE"
    sSQL = sSQL & " where DIR_RESPONSE.REQ_SEQ_NUM = DIR_REQUEST.REQ_SEQ_NUM"
    sSQL = sSQL & " and DIR_REQUEST.REQ_SEQ_NUM = " & nRequestNumber
    
    Set rsRequestDetails = adoConn.Execute(sSQL)
                        
    If rsRequestDetails.BOF <> True And rsRequestDetails.EOF <> True Then
        rsRequestDetails.MoveFirst
        'Check if the request is cancelled
        If Not IsNull(rsRequestDetails!CANCEL_STATUS) Then
            blReturnValue = rsRequestDetails!CANCEL_STATUS = "01"
        End If
    End If
    
PROC_EXIT:
    Set rsRequestDetails = Nothing
    
    If Err.Number <> 0 Then blReturnValue = False
    
    IsCancelledRequest = blReturnValue
    
End Function


Private Function GetParameterValue(ByRef sStage As String, ByVal sParameterName, ByRef adoConn As ADODB.Connection) As String
On Error GoTo PROC_EXIT
    
    Dim rsParameter As ADODB.Recordset
    Dim sReturnValue As String
    
    Set rsParameter = New ADODB.Recordset
    
    rsParameter.Open "dir_get_param_values '" & sParameterName & "'", adoConn
    
    If rsParameter.BOF = True And rsParameter.EOF = True Then
        ShowError 0, "The " & sParameterName & " parameter has not been set up", sStage
        sReturnValue = ""
    Else
        sReturnValue = rsParameter!VAR_VALUE
    End If
    
PROC_EXIT:
    Set rsParameter = Nothing
    
    GetParameterValue = sReturnValue
    
End Function


Private Function SendEmail(ByRef sStage As String, ByVal nRequestNumber As Long, _
                           ByVal sSubject As String, ByVal sBody As String, ByVal sFileName As String, _
                           ByVal sRecipientAddress As String, ByVal sRecipientName As String) As Boolean
On Error GoTo PROC_EXIT

    Dim cJMail As clsJMail
    Dim objRegistry As clsRegistry
    Dim ReturnValue As Boolean
    Dim OverrideEmailAddress As String
    
    Set cJMail = New clsJMail
    Set objRegistry = New clsRegistry
    
    cJMail.EMailServer = "trend1.liberty.co.za"
    cJMail.MsgFrom = "info@keytax.co.za"
    cJMail.MSGFromName = "KeyTax: Tax Directives"
    cJMail.MSGSubject = sSubject
    cJMail.MSGBody = sBody
    
    'Johan(2009/07/01): If an override email address is specified in the registry
    OverrideEmailAddress = objRegistry.EmailOverrideAddress
    If OverrideEmailAddress <> "" Then
        cJMail.AddRecipient OverrideEmailAddress, OverrideEmailAddress
    Else
        cJMail.AddRecipient sRecipientAddress, sRecipientName
    End If
    
    If sFileName <> "" Then cJMail.AddAttachment sFileName
    
    ReturnValue = cJMail.SendMSG
   
    If ReturnValue = False Then ShowError 0, "Error Sending Mail for request number " & nRequestNumber, sStage
    
    
PROC_EXIT:
    Set cJMail = Nothing
    Set objRegistry = Nothing
    
    SendEmail = ReturnValue
End Function


Private Sub SendErrorEmail(lngReqSeqNum As Long, strErrMsg As String)
    If Not SendEmail("Send Error Email", lngReqSeqNum, "Email Error", strErrMsg, "", "info@keytax.co.za", "KeyTax Support") Then
        ShowError 0, "Unable to send error email for request number " & lngReqSeqNum, "Send Error Email"
    End If
End Sub


Public Function IsAppRunning() As Boolean
    Dim blnResult As Boolean
    Dim strOldTitle As String

    'Is the application already loaded? if so then restore the previous instance of the prog by making it active and
    'bringing it to the top

    If App.PrevInstance Then
        'change the new instance title to prevent it from being located instead of the original
        strOldTitle = App.Title
        App.Title = App.Title & "...Duplicate"
        RestorePreviousInstance strOldTitle
        App.Title = strOldTitle

        blnResult = True
    Else
        blnResult = False
    End If

    IsAppRunning = blnResult

End Function


Private Sub RestorePreviousInstance(ByVal strPreviousTitle As String)
    Dim hPrevWin As Long
    Dim lngRetVal As Long
    Dim apiWindowPlacement As TWINDOWPLACEMENT

    'using the class name for the compiled exe class
    'prevents the routine from finding and attempting to
    'activate the project form of the same name

    hPrevWin = FindWindow(VB5_CLASS_NAME, strPreviousTitle)

      DoEvents

      If hPrevWin > 0 Then
        ' Get the current window state of the previous instance
        apiWindowPlacement.lngLength = Len(apiWindowPlacement)
        lngRetVal = GetWindowPlacement(hPrevWin, apiWindowPlacement)

        ' If the ShowCmd member indicates that the window
        ' is currently minimized, it needs to be restored, so...
        If apiWindowPlacement.lngShowCmd = SW_SHOWMINIMIZED Then
          apiWindowPlacement.lngShowCmd = Len(apiWindowPlacement)
          apiWindowPlacement.lngFlags = 0&
          apiWindowPlacement.lngShowCmd = SW_SHOWNORMAL
          lngRetVal = SetWindowPlacement(hPrevWin, apiWindowPlacement)
        End If

        ' Bring the window to the front and make it the active
        ' window.  Without this, it may remain behind other windows
        lngRetVal = SetForegroundWindow(hPrevWin)

        DoEvents

      End If

End Sub

'Author      : Sibusiso Maswanganye
'Updated     : Johann Marx (2009/06/30)
'Function    : Rendezvous Keytax directive with case on workflow or create case send to END Q
'Return Value: True [Successful] * False [UnSuccessful]
'Params      : ReqSeqNum        - Keytax Request Number
'            : KeytaxAttachment - Attached directive that was supposed to be sent to emailkst in PDF format
'            : DBConnection     - Current DB Connection from email program
'            : ErrorMessage     - Error message that might be returned when error while trying to rendezvous document
Public Function SaveCommitDetail(nRequestNumber As String, sFileName As String, adoConnection As ADODB.Connection, Optional sReturnErrorMessage As String = "") As Boolean
On Error GoTo PROC_EXIT
    Dim blReturnValue As Boolean
    
    Dim sErrorMessage As String
    
    Dim sTextPath As String
    Dim sMachineID As String
    
    Dim bSaveToSourceAudit As Boolean
    Dim sProcessFilename As String
    Dim lSourceAuditId As Long
    
    Dim nSourceId As String
    Dim sOverrideQueue As String
    Dim sOverrideComments As String
    
    Dim lCommitError As Long
    Dim lFilenetDocID As Long
    
    Dim sMasterTable As String
    Dim bWorkCreated As Boolean
    Dim sCreateWorkErrorMessage As String
    
'*********************************************************************************************************************
'Load the Email settings from the XML document
    If Not oXMLDocument.Load(App.Path & "\KeytaxEmail.xml") Then
        MsgBox "Could not load application settings XML file"
    End If
    
    'Get settings
    sBusinessUnit = oXMLDocument.getElementsByTagName("BusinessUnit").Item(0).Text
    strUserId = oXMLDocument.getElementsByTagName("UserName").Item(0).Text
    strPassword = DecryptWithALP(CStr(oXMLDocument.getElementsByTagName("Password").Item(0).Text))
    sTextPath = oXMLDocument.getElementsByTagName("TextPath").Item(0).Text
    sMachineID = oXMLDocument.getElementsByTagName("Machine_Id").Item(0).Text
    OracleConnectionString = DecryptWithALP(CStr(oXMLDocument.getElementsByTagName("ORACLECONNECT").Item(0).Text))
    SQLConnectionString = GetConnectionString()
    sBusinessUnitName = oXMLDocument.getElementsByTagName("BusinessUnitName").Item(0).Text
'*********************************************************************************************************************


'*********************************************************************************************************************
'Connect to Mindkey Database

    'Close any existing connections before connecting again
    On Error Resume Next
    modGeneral.DBConnection.CommitTrans
    modGeneral.DBConnection.Close
    
    On Error GoTo PROC_EXIT
    
    If Not modGeneral.DBConnect("", OracleConnectionString) Then
        blReturnValue = False
        sReturnErrorMessage = "Unable to connect to Workflow database"
        GoTo PROC_EXIT
    End If
'*********************************************************************************************************************



'*********************************************************************************************************************
'Save Source Audit record
    'Generate GUID as file
    sProcessFilename = GetGuid
    
    If Len(sProcessFilename) > 0 Then
        bSaveToSourceAudit = SaveToSourceAudit(lSourceAuditId, _
                                               sErrorMessage, _
                                               sProcessFilename, _
                                               sBusinessUnit, 1, _
                                               sMachineID)
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Get Mindkey Creatework settings
    If bSaveToSourceAudit And lSourceAuditId > 0 Then
        nSourceId = modGeneral.GetWorkSourceDetails(nRequestNumber, sMachineID, sOverrideQueue, sOverrideComments)
        
        'If the source lookup failed, raise an error
        If nSourceId = "" Then
            sReturnErrorMessage = "Work type retrieval failed or work type is not set up for Mindkey Integration"
            blReturnValue = False
            GoTo PROC_EXIT
        End If
    Else
        sReturnErrorMessage = "Source Audit record could not be created"
        blReturnValue = False
        GoTo PROC_EXIT
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Get SourceAudit ID for the file (Johann: Not sure why this code is here, it seems superfluous?)
'    Dim rsAudit As ADODB.Recordset
'
'    Set rsAudit = modGeneral.DBConnection.Execute("select source_audit_id from mss_source_audit where source_file = '" & UCase(sProcessFilename) & "'")
'
'    If rsAudit.BOF = True And rsAudit.EOF = True Then
'        'The source audit record was not found using filename now attempt exact-match filename search
'        Set rsAudit = modGeneral.DBConnection.Execute("select source_audit_id from mss_source_audit where source_file ='" & UCase(sProcessFilename) & "'")
'
'        If rsAudit.BOF = True And rsAudit.EOF = True Then
'            sReturnErrorMessage = "SourceAudit record could not be retrieved: " & UCase(sProcessFilename)
'            blReturnValue = False
'            GoTo PROC_EXIT
'        End If
'    End If
'
'    rsAudit.MoveFirst
'    lSourceAuditID = rsAudit!SOURCE_AUDIT_ID
'
'    Set rsAudit = Nothing
'*********************************************************************************************************************


'*********************************************************************************************************************
'Commit document to image store
    If Len(Trim(sFileName)) > 0 Then
        'Create object for committing images to image store if there are any to commit
        Set objImageLibrary = CreateObject("MSSImageLink.clsMSSImageLink")
        
        If ImageLibraryLogon Then
            lCommitError = CommitDocuments(nSourceId, sFileName, lFilenetDocID, modGeneral.DBConnection)
            
            If lCommitError <> 0 Or lFilenetDocID = 0 Then
                sReturnErrorMessage = objImageLibrary.MSS_ErrorMessage(lCommitError)
                blReturnValue = False
                GoTo PROC_EXIT
            End If
        Else
            sReturnErrorMessage = "Logon to Image Library failed"
            blReturnValue = False
            GoTo PROC_EXIT
        End If
    End If
'*********************************************************************************************************************


'*********************************************************************************************************************
'Create work item
    sMasterTable = modGeneral.GetSourceMasterTable(nSourceId)
              
    bWorkCreated = HandleCreateWork(sMasterTable, lFilenetDocID, nSourceId, 1, lSourceAuditId, _
                                    nRequestNumber, sImageStoreCD, sCreateWorkErrorMessage, _
                                    sOverrideQueue, sOverrideComments)
    
    If Not bWorkCreated Then
        sReturnErrorMessage = "Rendezvous/Create work failed. " & Chr(13) & Chr(13) & sCreateWorkErrorMessage
        blReturnValue = False
        GoTo PROC_EXIT
    End If
'*********************************************************************************************************************

    blReturnValue = True 'we reached the end of the method, success!
    
PROC_EXIT:
    If Err.Number <> 0 Then
        blReturnValue = False
    End If
    
    SaveCommitDetail = blReturnValue
End Function


Public Function AuditRequest(lSourceAuditId As Long) As Boolean
    Dim objSourceAudit As Object
    
    On Error GoTo errhandler:
    
    Set objSourceAudit = CreateObject("SourceAudit.clsAudit")
        objSourceAudit.ConnectionString = modGeneral.DBConnection.Connection
        
        AuditRequest = objSourceAudit.Audit(lSourceAuditId, sBusinessUnit)
    Exit Function
    
errhandler:
    ShowError Err.Number, Err.Description, "Audit Request"
    Exit Function
    Resume Next
End Function

'*-----------------------------------------------------------------
'* Method:      HandleCreateWork
'* Description: Creates or rendezvous a work item to Mindkey
'* Parameters:
'* Returns:     Boolean - true if succeeds, false if not
'*-----------------------------------------------------------------
Private Function HandleCreateWork(ByVal sMasterTable As String, _
                                  ByVal lFilenetDocID As Long, _
                                  ByVal nSourceId As String, _
                                  ByVal lDocCount As Long, _
                                  ByVal lSourceAuditId As Long, _
                                  Optional ByVal nRequestNumber As String, _
                                  Optional ByVal sImageStoreCD As String, _
                                  Optional ByRef sReturnErrorMessage As String = "", _
                                  Optional ByVal sOverideQueue As String = "", _
                                  Optional ByVal sOverideComments As String = "") As Boolean
'On Error GoTo PROC_EXIT
    Dim blReturnValue As Boolean
    
    Dim objLCBMaster As Object
    
    ShowStage "HandleCreateWork Enter"
    
    Select Case sMasterTable
        Case "LCB_MASTER"
            Dim nFundNumber As String
            Dim sSchemeNumber As String, sSchemeName As String, sMemberNumber As String
            Dim sSurname As String, sInitials As String, sIDNumber As String
            
            Set objLCBMaster = CreateObject("LCBWorkflow.clsWorkObject")
                objLCBMaster.ConnectionString = OracleConnectionString
                
           'Get Member number
            Call modGeneral.GetKeytaxIndexInfo(nRequestNumber, sMemberNumber, nFundNumber)
            
            ShowStage "HandleCreateWork: GetKeytaxIndexInfo done"
            
RESUME_CREATEWORK:
            Call modGeneral.GetSchemeAndMemberInfo(sSchemeNumber, _
                                                   sMemberNumber, _
                                                   sSchemeName, _
                                                   sSurname, _
                                                   sInitials, _
                                                   sIDNumber, nFundNumber)
                                                   
            ShowStage "HandleCreateWork: GetSchemeAndMemberInfo done"
            
            
            blReturnValue = objLCBMaster.CreateWorkItem(lFilenetDocID, _
                                                        "EMAIL", "SYSTEM", nSourceId, _
                                                        sSchemeNumber, sSchemeName, sMemberNumber, sSurname, sInitials, sIDNumber, _
                                                        "SYSTEM", lDocCount, lSourceAuditId, "2", sOverideComments, _
                                                        "", nNewCaseNumber, "", _
                                                        sOverideQueue)
                                                        
            ShowStage "HandleCreateWork: CreateWorkItem done. Result: " & blReturnValue
            
        Case Else
            blReturnValue = False
            sReturnErrorMessage = "The specified master table, " & sMasterTable & ", is not supported at this time"
            GoTo PROC_EXIT
    End Select
    
PROC_EXIT:
    If Err = -2147467259 Then
        GoTo RESUME_CREATEWORK
    ElseIf Err.Number <> 0 Then
        blReturnValue = False
        sReturnErrorMessage = Err.Description
        ShowError 0, sReturnErrorMessage, "HandleCreateWork"
        'SendEmail "HandleCreateWork", nRequestNumber, "Mindkey Integration Error", "Could not completely Mindkey Integration for request number " & nRequestNumber & ". " & Err.Description, "", "info@keytax.co.za", "KeyTax Support"
    End If
    
    Set objLCBMaster = Nothing
    
    HandleCreateWork = blReturnValue
End Function

'*-----------------------------------------------------------------
'* Method:      GetProcessFilename
'* Description: Generate a unique filename that will hold the
'*              processed information for this scan session
'* Parameters:  None
'* Returns:     String - The unique process filename
'*-----------------------------------------------------------------
Private Function GetProcessFilename(sStatioName As String, ASCIIFolder As String) As String
    Dim strFileName As String
    Dim strFileFolder As String
    Dim strFilePrefix As String
    Dim strFileSuffix As String
    Dim dtDate As Date
    
    On Error GoTo errhandler:
    
    dtDate = Now()
  
      ' Get the default file values
  
    strFileFolder = ASCIIFolder
    
    strFilePrefix = Format$(dtDate, "yyyymmddHhNnSs") & "_" & sStatioName
    strFileSuffix = "TXT"
  
  
    strFileName = GetTemporaryFilename(strFileFolder, strFilePrefix, strFileSuffix)
  
    GetProcessFilename = strFileName
    Exit Function
errhandler:
    ShowError 0, Err.Description, "Get Process Filename"
    Exit Function
    Resume Next
End Function

Private Function CommitDocuments(ByVal nSourceId As Long, StrFiles As String, lFnetDocId As Long, DBConn As ADODB.Connection) As Long
    
    Dim lngErr As Long
    
    On Error GoTo errhandler:
    
    lngErr = objImageLibrary.MSS_Commit(nSourceId, StrFiles, sBusinessUnit, lFnetDocId, sDefaultImageStoreCd)
    
    If lngErr <> 0 Or lFnetDocId = 0 Then
        CommitDocuments = lngErr
    End If
    
    Exit Function
    
errhandler:
    ShowError Err.Number, Err.Description, "Commit Documents"
    CommitDocuments = Err
    Exit Function
    Resume Next
End Function

'Method to create a text file
Private Function CreateTextFileFromBody(sBodyText As String, RequestNo As String) As String
    Dim sFileName As String
    
    On Error GoTo errhandler:
    
    sFileName = "c:\" & RequestNo & ".txt"
    
    Open sFileName For Output As #3
        Print #3, sBodyText
    Close #3
    
    CreateTextFileFromBody = sFileName
    
    Exit Function
    
errhandler:
    ShowError Err.Number, Err.Description, "Create Text File From Body"
    CreateTextFileFromBody = ""
    Exit Function
    Resume Next
End Function


Public Function ShowError(ByVal nErrorNumber As Long, ByVal sErrorMessage As String, ByVal sStage As String) As Boolean
    Form2.txtErrors.Text = (Now() & vbTab & nErrorNumber & ". " & sErrorMessage & " (" & sStage & ")") & vbCrLf & Form2.txtErrors.Text
End Function

Public Function UpdateRemainingCount(ByVal nRemCount As Long, ByVal nComplCount As Long) As Boolean
    Form2.lblProgress.Caption = nComplCount & " request(s) completed, " & nRemCount & " remaining"
    DoEvents
End Function

Public Function ShowStage(ByVal sStage As String) As Boolean
    Form2.lblStatus.Caption = sStage
    DoEvents
    'MsgBox sStage
End Function

Public Function UpdateList(ByVal nCounter As Integer, ByVal sMessage As String) As Boolean
    'Form2.List1.AddItem CStr(nCounter) & " - " & sMessage
    'Form2.List1.ListIndex = nCounter - 1
    Form2.List1.AddItem Now() & vbTab & sMessage, 0
    DoEvents
End Function

Public Function PopulateReport(ByVal sConnStr As String, ByRef adoComm As ADODB.Command) As Boolean
On Error GoTo ErrorHandler

    crFormC.DiscardSavedData 'clear out old data
    crFormC.Database.AddADOCommand sConnStr, adoComm
    crFormC.Database.Verify
    
    PopulateReport = True
    Exit Function
    
ErrorHandler:
    PopulateReport = False
    
End Function
